
; Test cases for stored object handling

; Note: Some of the stored object instructions are also needed during initialization of 
;   the heap image to create closures. So if they are wrong, the testing will probably 
;   not even get to this point 

(define-test-suite stob-tests "stob-tests" (lambda ()

  ; Test the generic stob opcodes
  (bool-test double? (double? (make-double)) "stored-object-has-type?" #t)
  (bool-test double? (double? (make-string 5)) "stored-object-has-type?" #f)
  
  (arith-test string-length (string-length "abcdef") "stored-object-length" 6)
  
  (bool-test cons (pair? (cons 1 2)) "make-stored-object" #t)
  (bool-test car (eq? (car (cons 1 2)) 1) "stored-object-ref" #t)
  (thunk-test set-car! "stored-object-set!"
    (lambda ()
      (let ((c (cons 1 2)))
        (set-car! c 101)
        (eq? (car c) 101))))   
     
  ; Vectors use make-vector-object, stored-object-indexed-ref or set!
  (arith-test make-vector (vector-length (make-vector 3)) "make-vector0" 3)
  (arith-test make-vector (vector-length (make-vector 3 4)) "make-vector1" 3)
  (arith-test make-vector (vector-ref (make-vector 3 4) 2) "make-vector2" 4)
   
  (arith-test make-byte-vector (byte-vector-length (make-byte-vector 3 0)) "make-byte-vector" 3)
  ;; (arith-test make-unmovable-byte-vector (byte-vector-length (make-unmovable-byte-vector 3 0)) "make-unmovable-byte-vector" 3)
  (arith-test byte-vector-ref (byte-vector-ref (make-byte-vector 3 4) 2) "byte-vector-ref" 4)
  ((lambda (v)
     (byte-vector-set! v 0 1)
     (arith-test (byte-vector-ref v 0) "byte-vector-set!" 1)
     (arith-test (byte-vector-ref v 1) "byte-vector-set!" 0))
   (make-byte-vector 3 0))  
   
  (arith-test make-string (string-length (make-string 3)) "make-string0" 3)
  (arith-test make-string (string-length (make-string 3 #\a)) "make-string1" 3)
  (arith-test make-string (- (char->scalar-value (string-ref (make-string 3) 2))
		 (char->scalar-value #\?))
	      "make-string2" 0)
  (arith-test make-string (- (char->scalar-value (string-ref (make-string 3 #\a) 2))
		 (char->scalar-value #\a))
	      "make-string3" 0)

  (arith-test string-length (string-length "hello world") "string-length" 11) 

   ((lambda (s)
      (string-set! s 2 #\b)
      (string-set! s 3 #\c)
      (bool-test (string=? s "aabca") "string-set" #t))
    (make-string 5 #\a))  
      
   ((lambda (s)
      (copy-string-chars! "abcdefghijk" 4 s 3 4)
      (copy-string-chars! s 3 s 0 2)
      (bool-test (string=? s "ef efgh   ") "copy-string-chars!" #t))
    (make-string 10 #\space))
        
   (bool-test reverse-list->string (string=? (reverse-list->string '() 0) "") "reverse-list->string1" #t)
   (bool-test reverse-list->string (string=? (reverse-list->string (list #\c #\b #\a) 3) "abc") "reverse-list->string2" #t)
 
   (bool-test string-hash (eq? (string-hash "Hello") (string-hash "Hello")) "string-hash" #t)
   (bool-test string-hash (eq? (string-hash "Hello") (string-hash "World")) "string-hash" #f)   
   
   ; cell-set! has a separate compilator, so test cells separately
   (bool-test make-cell (cell? (make-cell 0)) "make-cell" #t)
   (bool-test cell? (cell? (cons 0 1)) "cell?" #f)   
   ((lambda (c)
      (arith-test cell-ref (cell-ref c) "cell-ref" 0)
      (cell-set! c 1)
      (arith-test cell-ref (cell-ref c) "cell-set!" 1))
    (make-cell 0))

  ))